perm filename MFDD.FAI[MF,DEK]1 blob
sn#746948 filedate 1984-03-26 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00006 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE MFDD P BEGX BEGY XSIZE YSIZE XWORDS EXCT FNCN CHNL COLM HILIN LOLIN DDPROG DDEND DDLEN NDDCW ROWTAB CMDBLK
C00005 00003 INITSCREEN
C00006 00004 BEGIN BLANKRECTANGLE X0 X1 Y0 Y1 T0 T1 T2 T3 T4 BLANK1 BLANK2
C00009 00005 BEGIN PAINTROW R B A N X0 X1 T0 T1 T2 T3 PAINT2 PAINT3 PAINTX
C00013 00006 UPDSCREEN
C00014 ENDMK
C⊗;
TITLE MFDD ;⊗ P BEGX BEGY XSIZE YSIZE XWORDS EXCT FNCN CHNL COLM HILIN LOLIN DDPROG DDEND DDLEN NDDCW ROWTAB CMDBLK
;DataDisc display routines for MetaFont, callable from Hedrick Pascal (PSC).
;Specifications by Donald Knuth, code by Joe Weening, February 1984.
;Ideas borrowed from display code in DVIDD and WHOPHN.
TWOSEG
↓P←17 ;Our friendly push-down pointer
;Our screen dimensions should have the following relation to MF's:
; screen_width = XSIZE - BEGX
; screen_depth = YSIZE
;
BEGX←←=8 ;First pixel to use in X-direction
BEGY←←=36 ;First pixel to use in Y-direction
XSIZE←←=500 ;Number of pixels in X-direction
YSIZE←←=380 ;Number of pixels in Y-direction
;(should be a multiple of 4)
XWORDS←←<XSIZE+=31>/32 ;Words per row in DD program (32 bits per word)
DEFINE CW(C1,B1,C2,B2,C3,B3)<<BYTE (8)B1,B2,B3(3)C1,C2,C3>!4>
EXCT←←0 ;Execute
FNCN←←1 ;Function
CHNL←←2 ;Channel
COLM←←3 ;Column select
HILIN←←4 ;Set high 5 bits of line adr
LOLIN←←5 ;Set low 4 bits of line adr
;Here we set up DDPROG and ROWTAB so that the lines in DDPROG are 0,4,8,...,
;then 1,5,9,..., then 2,6,10,..., then 3,7,11,..., and ROWTAB+I points to
;the line word in line I, for 0≤I<YSIZE.
RELOC 0 ;For data
DDPROG:
;LINEWD of first line in DDPROG is changed by code at SHOWDD.
FOR I←0,3<
FOR J←I,YSIZE-1,4<
CW 0,0,HILIN,<<BEGY+J>⊗-4>,LOLIN,<<BEGY+J>&17> ;LINEWD
CW FNCN,7,FNCN,7,COLM,1 ;COLMWD
REPEAT XWORDS,<
2>
>;FOR J
>;FOR I
CW 0,0,CHNL,0,CHNL,0 ;Execute the last line
DDEND: 0 ;Make sure DD prog ends with a halt
DDLEN←←.-DDPROG
NDDCW←←2 ;Number of extra DD CWs per graphics line (LINEWD,COLMWD)
ROWTAB: FOR I←0,YSIZE/4-1
< FOR J←I,YSIZE-1,YSIZE/4
< DDPROG+J*<NDDCW+XWORDS>+NDDCW
>>
CMDBLK: DDPROG ;Command block for DDUPG to display DDPROG
DDLEN
0
0
RELOC 400000 ;For code
;INITSCREEN
;function init_screen: boolean; extern;
;
;Returns TRUE if we're on a DD terminal; FALSE otherwise.
INITSCREEN↑:
SETO 1,
GETLIN 1 ;Get our line characteristics
SETOM 1(P) ;Set return to TRUE
CAME 1,[-1] ;Skip if detached
TLNN 1,20000 ;Skip if a DD
SETZM 1(P) ;Not a DD, return FALSE
MOVEI 1,CHNL ;Put CHNL cmd
DPB 1,[POINT 3,DDPROG,26] ;in first word of DD prog
POPJ P,
BEGIN BLANKRECTANGLE ;⊗ X0 X1 Y0 Y1 T0 T1 T2 T3 T4 BLANK1 BLANK2
;procedure blank_rectangle(left_col,right_col:screen_col;
; top_row,bot_row:screen_row); extern;
;
;Whiten all pixels that lie in columns left_col through right_col-1, inclusive,
;of rows top_row through bot_row-1.
X0←2 ;left_col
X1←3 ;right_col
Y0←4 ;top_row
Y1←5 ;bot_row
T0←6 ;Scratch ACs
T1←7
T2←10
T3←11
T4←12
BLANKRECTANGLE↑:
CAMGE X0,X1 ;Test easy cases
CAML Y0,Y1
POPJ P,
ADDI X0,BEGX ;Adjust X0 and X1 to our left edge
ADDI X1,BEGX-1 ;and subtract 1 from X1 while we're at it
MOVE T0,X0
LSH T0,-5 ;Get X0's word position in T0
ANDI X0,37 ;Bit position in X0
MOVN T2,X0 ;Negate
SETO X0, ;Get an all 1's mask
LSH X0,(T2) ;Make mask for first column
TRZ X0,17 ;Zero non-data bits
MOVE T1,X1
LSH T1,-5 ;Get X1's word position in T1
ANDI X1,37 ;Bit position in X1
MOVN T2,X1 ;Negate
SETO X1, ;Get an all 1's mask
LSH X1,-1(T2) ;Make mask for last column
MOVE T2,X0 ;Start with mask for first column
BLANK1: CAMN T0,T1 ;Is this the last column?
ANDCM T2,X1 ;Yes, mask appropriately
MOVE T4,Y0 ;Start T4 at first row
BLANK2: MOVE T3,ROWTAB(T4) ;Point to row in DD prog
ADD T3,T0 ;Point to proper word
ANDCAM T2,(T3) ;Clear selected bits
CAIGE T4,-1(Y1) ;All done this column?
AOJA T4,BLANK2 ;No, do another row in column
MOVE T2,[777777,,777760];Set mask for next column
CAMGE T0,T1 ;All done?
AOJA T0,BLANK1 ;No, do another column
POPJ P,
BEND BLANKROW
BEGIN PAINTROW ;⊗ R B A N X0 X1 T0 T1 T2 T3 PAINT2 PAINT3 PAINTX
;procedure paintrow(y,n:integer;var x:array); extern;
;
;In row y, erase pixels between x[2k] and x[2k+1]-1, and blacken pixels
;between x[2k+1] and x[2k+2]-1, given the values x[0]<x[1]< ... <x[2n+1].
;We always start and end with a clearing operation.
;procedure paintrow(r:screen_row; b:pixel_color; var a:trans_spec;
; n:screen_column);
;In row r, alternately clear and blacken pixels (starting with the operation
;specified by b), in columns a[0]..a[1]-1, a[1]..a[2]-1, ..., a[n-1]..a[n]-1.
R←2 ;Parameters
B←3
A←4
N←5
X0←6 ;Temporary ACs
X1←7
T0←10
T1←11
T2←12
T3←13
PAINTROW↑:
DMOVE X0,(A) ;Get next two values from A array into X0,X1
ADDI X0,BEGX ;Adjust X0 and X1 to our left edge
ADDI X1,BEGX-1 ;and subtract 1 from X1 while we're at it
CAMLE X0,X1 ;Make sure there's work to do
JRST PAINT3 ;If not, skip to next operation
MOVE T0,X0
LSH T0,-5 ;Get X0's word position in T0
ANDI X0,37 ;Bit position in X0
MOVN T2,X0 ;Negate
SETO X0, ;Get an all 1's mask
LSH X0,(T2) ;Make mask for first column
TRZ X0,17 ;Zero non-data bits
MOVE T1,X1
LSH T1,-5 ;Get X1's word position in T1
ANDI X1,37 ;Bit position in X1
MOVN T2,X1 ;Negate
SETO X1, ;Get an all 1's mask
LSH X1,-1(T2) ;Make mask for last column
MOVE T2,X0 ;Start with mask for first column
PAINT2: CAMN T0,T1 ;Is this the last column?
ANDCM T2,X1 ;Yes, mask appropriately
MOVE T3,ROWTAB(R) ;Point to row in DD prog
ADD T3,T0 ;Point to proper word
XCT PAINTX(B) ;Clear or blacken selected bits
MOVE T2,[777777,,777760];Set mask for next column
CAMGE T0,T1 ;All done?
AOJA T0,PAINT2 ;No, do another column
PAINT3: MOVEI A,1(A) ;Advance to next operation
TRC B,1 ;Complement B
SOJG N,PAINTROW ;Continue until done
POPJ P,
PAINTX: ANDCAM T2,(T3) ;Clear selected bits (B=0)
IORM T2,(T3) ;Blacken selected bits (B=1)
BEND PAINTROW
;UPDSCREEN
;procedure updscreen; extern;
;
;Display the DD program.
UPDSCREEN↑:
PPSEL 1 ;Select PP 1
DPYPOS -663 ;Position page printer
DPYSIZ 3001
DDUPG CMDBLK ;Do the display
POPJ P,
END